home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / dbase / lib19.zip / CONVERT.PRG < prev    next >
Text File  |  1992-08-11  |  26KB  |  735 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program...: CONVERT.PRG
  3. *-- Programmer: Ken Mayer (KENMAYER)
  4. *-- Date......: 06/25/1992
  5. *-- Notes.....: This is the numeric conversion/calculation library file. See
  6. *--             the file README.TXT for details on the use of this file.
  7. *-------------------------------------------------------------------------------
  8.  
  9. FUNCTION Roman
  10. *-------------------------------------------------------------------------------
  11. *-- Programmer..: Nick Carlin
  12. *-- Date........: 04/26/1992
  13. *-- Notes.......: A function designed to return a Roman Numeral based on
  14. *--               an Arabic Numeral input ...
  15. *-- Written for.: dBASE III+
  16. *-- Rev. History: 04/13/1988 - original function.
  17. *--               07/25/1991 - Ken Mayer - 1) modified for dBASE IV, 1.1,
  18. *--                             2) updated to a function, and 3) the procedure
  19. *--                             GetRoman was done away with (combined into the
  20. *--                             function).
  21. *--               04/26/1992 - Jay Parsons - shortened (seriously ...)
  22. *-- Calls.......: None
  23. *-- Called by...: Any
  24. *-- Usage.......: Roman(<nArabic>)
  25. *-- Example.....: ? Roman(32)
  26. *-- Returns.....: Roman Numeral (character string) equivalent of Arabic numeral
  27. *--               passed to it. In example:  XXXII
  28. *-- Parameters..: nArabic = Arabic number to be converted to Roman
  29. *-------------------------------------------------------------------------------
  30.  
  31.    parameters nArabic
  32.    private cLetrs,nCount,nValue,cRoman,cGroup,nMod
  33.     
  34.    cLetrs ="MWYCDMXLCIVX"      && Roman digits
  35.    cRoman = ""                 && this is the returned value
  36.    nCount = 0                  && init counter
  37.    do while nCount < 4         && loop four times, once for thousands, once
  38.                                && for each of hundreds, tens and singles
  39.       nValue = mod( int( nArabic /  10 ^ ( 3 - nCount ) ), 10 )
  40.       cGroup = substr( cLetrs, nCount * 3 + 1, 3 )
  41.       nMod = mod( nValue, 5 )
  42.       if nMod = 4
  43.          if nValue = 9                 && 9
  44.             cRoman = cRoman + left( cGroup, 1 ) + right( cGroup, 1 )
  45.          else                          && 4
  46.             cRoman = cRoman + left( cGroup, 2 )
  47.          endif
  48.       else
  49.          if nValue > 4                 && 5 - 8
  50.             cRoman = cRoman + substr( cGroup, 2, 1 )
  51.          endif
  52.          if nMod > 0                   && 1 - 3 and 6 - 8
  53.             cRoman = cRoman + replicate( left( cGroup, 1 ), nMod )
  54.          endif
  55.       endif
  56.       nCount = nCount + 1
  57.    enddo  && while nCounter < 4
  58.     
  59. RETURN cRoman
  60. *-- EoF: Roman()
  61.  
  62. FUNCTION Arabic
  63. *-------------------------------------------------------------------------------
  64. *-- Programmer..: Ken Mayer (KENMAYER)
  65. *-- Date........: 04/26/1992
  66. *-- Notes.......: This function converts a Roman Numeral to an arabic one.
  67. *--               It parses the roman numeral into an array, and checks each 
  68. *--               character ... if the previous character causes the value to 
  69. *--               subtract (for example, IX = 9, not 10) we subtract that value, 
  70. *--               and then set the previous value to 0, otherwise we would get 
  71. *--               some odd values in return.
  72. *--               So far, it works fine.
  73. *-- Written for.: dBASE IV, 1.1
  74. *-- Rev. History: 07/15/1991 - original function.
  75. *--               04/26/1992 - Jay Parsons - shortened.
  76. *-- Calls.......: None
  77. *-- Called by...: Any
  78. *-- Usage.......: Arabic(<cRoman>)
  79. *-- Example.....: ?Arabic("XXIV")
  80. *-- Returns.....: Arabic number (from example, 24)
  81. *-- Parameters..: cRoman = character string containing roman numeral to be
  82. *--               converted.
  83. *-------------------------------------------------------------------------------
  84.  
  85.   parameters cRoman
  86.   private cRom,cLetrs,nLast,nAt,nVal,cChar,nArabic
  87.     
  88.    cRom = ltrim(trim(upper(cRoman))) && convert to all caps in case ...
  89.    cLetrs = "IVXLCDMWY"
  90.    nArabic = 0
  91.    nLast = 0
  92.    do while len( cRom ) > 0
  93.       cChar = right( cRom, 1 )
  94.       nAt = at( cChar, cLetrs )
  95.       nVal= 10 ^ int( nAt/2 ) / iif(nAt/2 = int(nAt/2),2,1)
  96.       do case
  97.          case nAt = 0
  98.             nArabic = 0
  99.             exit
  100.          case nAt >= nLast
  101.             nArabic = nArabic + nVal
  102.             nLast = nAt
  103.          otherwise
  104.             if nAt/2 = int( nAt / 2 )
  105.                nArabic = 0
  106.                exit
  107.             else
  108.                nArabic = nArabic - nVal
  109.             endif
  110.       endcase
  111.       cRom = left( cRom, len( cRom ) - 1 )
  112.    enddo
  113.     
  114. RETURN nArabic
  115. *-- EoF: Arabic()
  116.  
  117. FUNCTION Factorial
  118. *-------------------------------------------------------------------------------
  119. *-- Programmer..: Jay Parsons (JPARSONS)
  120. *-- Date........: 03/01/1992
  121. *-- Notes.......: Factorial of a number; returns -1 if number is not a
  122. *--               positive integer.
  123. *-- Written for.: dBASE IV, 1.1
  124. *-- Rev. History: None
  125. *-- Calls.......: None
  126. *-- Called by...: Any
  127. *-- Usage.......: Factorial(<nNumber>)
  128. *-- Example.....: ? Factorial( 6 )
  129. *-- Returns.....: Numeric = number factorial <in example, 6! or 720>
  130. *-- Parameters..: nNumber = number for which factorial is to be determined
  131. *-------------------------------------------------------------------------------
  132.  
  133.     parameters nNumber
  134.     private nNext, nProduct
  135.     if nNumber # int( nNumber ) .or. nNumber < 1
  136.       RETURN -1
  137.     endif
  138.     nProduct = 1
  139.     nNext = nNumber
  140.     do while nNext > 1
  141.       nProduct = nProduct * nNext
  142.       nNext = nNext - 1
  143.     enddo
  144.     
  145. RETURN nProduct
  146. *-- Eof: Factorial()
  147.                                  
  148. FUNCTION IsPrime
  149. *-------------------------------------------------------------------------------
  150. *-- Programmer..: Jay Parsons (JPARSONS)
  151. *-- Date........: 08/11/1992
  152. *-- Notes.......: Returns .t. if argument is prime positive integer, or .f.
  153. *-- Written for.: dBASE IV, 1.1
  154. *-- Rev. History: 03/11/92 - original function.
  155. *--             : 08/11/92 - revised to return .T. for 2. ( Tea for two? )
  156. *-- Calls.......: None
  157. *-- Called by...: Any
  158. *-- Usage.......: IsPrime(<nNumber>)
  159. *-- Example.....: ? IsPrime( 628321 )
  160. *-- Returns.....: Logical = .t. if prime
  161. *-- Parameters..: nNumber = positive integer to test for being prime
  162. *-------------------------------------------------------------------------------
  163.  
  164.    parameters nNumber
  165.    private nFactor, nLimit, lResult
  166.    if nNumber < 1 .or. nNumber # int( nNumber ) ;
  167.       .or. ( nNumber > 2 .AND. mod( nNumber, 2 ) = 0 )
  168.       RETURN .f.
  169.    endif
  170.    nFactor = 3
  171.    nLimit = sqrt( nNumber )
  172.    lResult = .t.
  173.    do while nFactor <= nLimit
  174.       if mod( nNumber, nFactor ) = 0
  175.          lResult = .f.
  176.          exit
  177.       endif
  178.       nFactor = nFactor + 2
  179.    enddo
  180.  
  181. RETURN lResult
  182. *-- Eof: IsPrime()
  183.  
  184. FUNCTION BankRound
  185. *-------------------------------------------------------------------------------
  186. *-- Programmer..: Jay Parsons (JPARSONS)
  187. *-- Date........: 03/01/1992
  188. *-- Notes.......: Rounds numeric argument to given number of places,
  189. *--               which if positive are decimal places, otherwise
  190. *--               trailing zeroes before the decimal, in accordance
  191. *--               with the special banker's rule that if the value
  192. *--               lost by rounding is exactly halfway between two
  193. *--               possible digits, the final digit expressed will be even.
  194. *-- Written for.: dBASE IV, 1.1
  195. *-- Rev. History: None
  196. *-- Calls.......: None
  197. *-- Called by...: Any
  198. *-- Usage.......: BankRound(<nNumber>,<nPlaces>)
  199. *-- Example.....: ? BankRound( 357.725, 2 )
  200. *-- Returns.....: Numeric = rounded value ( 357.72 in example )
  201. *-- Parameters..: nNumber = numeric value to round
  202. *--               nPlaces = decimal places, negative being powers of 10
  203. *-------------------------------------------------------------------------------
  204.  
  205.     parameters nNumber, nPlaces
  206.     private nTemp
  207.     nTemp = nNumber * 10 ^ nPlaces +.5
  208.     if nTemp = int( nTemp ) .and. nTemp / 2 # int( nTemp / 2 )
  209.       nTemp = nTemp - 1
  210.     endif
  211.     
  212. RETURN int( nTemp ) / 10 ^ nPlaces
  213. *-- Eof: BankRound()
  214.  
  215. FUNCTION Num2Str
  216. *--------------